home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Languages / MS Fortran 5.1 / DISK6 / MAGNIFY.FO$ / MAGNIFY.bin
Encoding:
Text File  |  1990-09-28  |  4.6 KB  |  135 lines
  1. CC  MAGNIFY.FOR - Illustrates translation between window and view
  2. CC                coordinate systems using the following functions:
  3. CC                getphyscoord     getviewcoord   getviewcoord_w
  4. CC                getwindowcoord   lineto        moveto 
  5. CC                rectangle        rectangle_w    settextposition
  6. CC                setwindow       setviewport
  7. CC
  8. CC  Although not all illustrated here, functions ending in _w
  9. CC  are similar to rectangle_w.
  10.  
  11.       INCLUDE  'FGRAPH.FI'
  12.       INCLUDE  'FGRAPH.FD'
  13.  
  14.       INTEGER*2              status, rseed, j, k, m, n
  15.       INTEGER*2              coord(3,2,2), fill(2)
  16.       INTEGER*4              i
  17.       REAL*4                 rand
  18.       DOUBLE PRECISION       x(2), y(2)
  19.       CHARACTER*18           text
  20.       RECORD / xycoord  /    xy, xy1
  21.       RECORD / wxycoord /    wxy
  22.       RECORD / rccoord  /    curpos
  23.       RECORD / videoconfig / vc
  24.       DATA text / 'magnification:  1x' /
  25.       DATA fill / $GFILLINTERIOR, $GBORDER /
  26.  
  27. C
  28. C     Find graphics mode.
  29. C
  30.       IF( setvideomode( $MAXRESMODE ) .EQ. 0 ) 
  31.      +    STOP 'Error:  cannot set graphics mode'
  32.       CALL getvideoconfig( vc )
  33.  
  34. C
  35. C     Find physical (pixel) coordinates for windows 1, 2, and 3.
  36. C
  37.       coord(1,1,1) = vc.numxpixels * 3 / 16
  38.       coord(1,1,2) = vc.numypixels * 7 / 32
  39.       coord(1,2,1) = coord(1,1,1) + vc.numxpixels / 8
  40.       coord(1,2,2) = coord(1,1,2) + vc.numypixels / 16
  41.       coord(2,1,1) = vc.numxpixels * 9 / 16
  42.       coord(2,1,2) = vc.numypixels * 5 / 32
  43.       coord(2,2,1) = coord(2,1,1) + vc.numxpixels * 3 / 8
  44.       coord(2,2,2) = coord(2,1,2) + vc.numypixels * 3 / 16
  45.       coord(3,1,1) = 0
  46.       coord(3,1,2) = vc.numypixels / 2
  47.       coord(3,2,1) = vc.numxpixels - 1
  48.       coord(3,2,2) = vc.numypixels - 1
  49.  
  50. C
  51. C     Connect windows with lines.
  52. C
  53.       status = setcolor( 4 )
  54.       DO i = 1, 2
  55.          DO j = 1, 2
  56.             DO k = 1, 2
  57.                CALL moveto( coord(i,j,1), coord(i,k,2), xy )
  58.                status = lineto( coord(i + 1,j,1), coord(i + 1,k,2) )
  59.             END DO
  60.          END DO
  61.       END DO
  62.  
  63. C
  64. C     Label windows and frame with rectangles.
  65. C
  66.       DO i = 1, 3
  67.          status  = setcolor( i )
  68.          row    = ( coord(i,1,2) * 25 ) / vc.numypixels
  69.          column = ( coord(i,1,1) * 80 ) / vc.numxpixels
  70.          CALL settextposition( row, column, curpos )
  71.          CALL outtext( text )
  72.          text(17:17) = '3'
  73.  
  74.          IF( i .EQ. 2 ) text(17:17) = '8'
  75.          CALL setviewport(  coord(i,1,1), coord(i,1,2) ,
  76.      +                      coord(i,2,1), coord(i,2,2) )
  77.          CALL getviewcoord( coord(i,1,1), coord(i,1,2), xy  )
  78.          CALL getviewcoord( coord(i,2,1), coord(i,2,2), xy1 )
  79.          status = rectangle( $GBORDER, xy.xcoord, xy.ycoord,
  80.      +                      xy1.xcoord, xy1.ycoord )
  81.       END DO
  82.  
  83. C
  84. C     Seed random number generator.
  85. C
  86.       CALL GETTIM( status, status, status, rseed )
  87.       CALL SEED( rseed )
  88. C
  89. C     Get random window coordinates (x, y) for rectangles,
  90. C     where x and y are between 0 and 1000.
  91. C
  92.       DO i = 8, 15
  93.          status = setcolor( i )
  94.          CALL RANDOM( rand )
  95.          x(1)  = rand * 980.0
  96.          x(2)  = rand * ( 999.0 - x(1) ) + x(1)
  97.          CALL RANDOM( rand )
  98.          y(1)  = rand * 980.0
  99.          y(2)  = rand * ( 999.0 - y(1) ) + y(1)
  100.          k     = rand + 1.5
  101.  
  102. C
  103. C        Display rectangles in normal and magnified views.
  104. C
  105.          DO j = 1, 3
  106.             CALL setviewport( coord(j,1,1), coord(j,1,2) ,
  107.      +                        coord(j,2,1), coord(j,2,2) )
  108.             status = setwindow( .TRUE., 0.0, 0.0, 1000.0, 1000.0 )
  109.             status = rectangle_w( fill(k), x(1), y(1), x(2), y(2) )
  110. C
  111. C           In last window, make rectangle sides 2 pixels wide by
  112. C           encasing unfilled rectangles with another rectangle.
  113. C           Convert window coords (x, y) to physical coords, 
  114. C           adjust, and translate back into window coords.
  115. C
  116.             IF( (j .EQ. 3)  .AND.  (k .EQ. 2) ) THEN
  117.                m = -1
  118.                DO n = 1, 2
  119.                   CALL getviewcoord_w(x(n), y(n), xy)
  120.                   CALL getphyscoord(xy.xcoord, xy.ycoord, xy)
  121.                   CALL getviewcoord(xy.xcoord+m, xy.ycoord+m, xy)
  122.                   CALL getwindowcoord(xy.xcoord, xy.ycoord, wxy)
  123.                   x(n) = wxy.wx
  124.                   y(n) = wxy.wy
  125.                   m    = 1
  126.                END DO
  127.             status = rectangle_w( fill(k), x(1), y(1), x(2), y(2) )
  128.             END IF
  129.          END DO
  130.       END DO
  131.  
  132.       READ (*,*)  ! Wait for ENTER to be pressed
  133.       status = setvideomode( $DEFAULTMODE )
  134.       END
  135.